Optional Framework.f

Requires SEKI
Requires Vectors
Requires Quicksort
Requires Kagi
Requires SORA\Motifs
Requires SORA\Tilemap-display
Requires SORA\Sprites
Requires Dorothy

Only Forth Definitions



Type: list
   int.field start
   int.field length
end-type


macro: list.count  int.2@ ;


method: list.init  ( addr list -- )
   start.!  length.clear ;


: list.++   ( list -- )
   1 swap length.+! ;


motif expand
   int.field hidden?
   int.field 'sort
   list.field opaques
   list.field transparents
end-type

\ Built up each frame
5000 Stack: opaque-buf
5000 Stack: transparent-buf

: end-frame
   seki-end-frame
   opaque-buf clear-stack
   transparent-buf clear-stack
   poll-all ;

0 value pass  \  0 = opaque, 1 = transparent


method: motif.them   pass if transparents.count else opaques.count then ;

method: motif.sort-for-display   'sort.@ execute ;

method: motif.funnel
   each:[ hidden?.@ not if alpha.@ if
      alpha.@ 255 < if
         this transparent-buf.push  parent.@ motif.transparents.++
      else
         this opaque-buf.push  parent.@ motif.opaques.++
      then
      children? if sort-for-display then
   then then ;] ;

method: motif.sift
   each:[ hidden?.@ not if @alpha if
      this opaque-buf.push  parent.@ motif.opaques.++
      children? if sort-for-display then
   then then ;] ;

: sort-front-to-back
   sort:[ motif.z.@ ;] ;

: sort-back-to-front
   sort:[ motif.z.@ negate ;] ;

method: motif.sort-by-z
   sift  opaques.count  sort-back-to-front ;

method: motif.sort-2d
   funnel  opaques.count sort-front-to-back
           transparents.count sort-back-to-front ;

method: motif.update  ( motif -- )
   opaque-buf.top cell+ opaques init-list
   transparent-buf.top cell+ transparents init-list
   sort-for-display ;

: shows  ( addr count -- )
   0 ?do @+ show loop drop ;

method: motif.render  ( root-motif -- )
   update
   0 to pass
   show
   1 to pass
   glDepthMask( GL_FALSE )
   show
   glDepthMask( GL_TRUE ) ;


\ Spritebatches

2D GL_QUADS Vbuf: 2d-quads-vbuf

motif extend: spritebatch
   image pointer img
end-type

\ spritebatch children
motif expand
   subimage pointer subimg      \ address
   byte field flip          \ bitmask:  1 = horizontal, 2 = vertical
end-type

: motif.show-as-sprite ( motif -- )
   <<  subimg.@.flip.@   flip.@  xor  to (flip)
       subimg.@  transform  sprite-vertices  >> ;

: spritebatch.construct ( image -- )
   super.construct
   <<
      img.!
      ['] sift 'sort.!
      show:[
         update
         img.@.bind
         them nip 4 * 2d-quads-vbuf draw:[
            them 0 ?do @+ motif.show-as-sprite loop drop
         ;]
      ;]
   >> ;

\ user can just type SPRITEBATCH.MAKE:

\ : Spritebatch:  ( image -- <name> )
\    spritebatch.make: ;




\ 2DCamera - probably will become a 2dview and 2dcamera
0 Value cam

inside motif.<<
: 2DCamera ( -- )
   ['] sift 'sort !
   show:[
      them nip if
         gl-depthtest gl-disable
         glDepthMask( GL_FALSE )
         push-modelview
         glTranslatef( x.@ negate .>f  y.@ negate .>f  0e )
         glRotatef( rotation.@ .>f 0e fdup 1e )
         glScalef( sx.@ .>f  sy.@ .>f  1e )
         cam >q  me to cam
         them shows
         q> to cam
         pop-modelview
      then
   ;] ;
>>
